Programmer Power Tools/Programmer Power Tools.iso/turbopas/sfmsrc.arc/SFMFUNC.INC

Text File | 1987-11-15 | 24KB | 960 lines

{                        Super File Manager

                            SFMFUNC.INC

                         by David Steiner
                            2035 J Apt. 6
                            Lincoln, NE


   These routines serve as an interface between the user and
     the low level DOS calls located in sfmDOS.inc.  They also
     call upon the routines in sfmSCRN.inc to help perform
     input and output.
}

function ChangePath( w : integer ) : boolean;
  {
  Prompt user to enter a new path for the window specified.
  }
var
  tstr  : str80;
  tw, i : integer;
  err   : boolean;
begin
  err := true;
  if loaded[w] then tw := w
  else tw := 3 - w;
  Wind( 3 );
  clrscr;
  writeln;
  Disp( NATTR, ' Enter a new path > ' );
  tstr := GetLine( X2 - wherex - 1 );
  writeln;
  if pos( ':', tstr ) = 0 then
    i := ChangeCurDir( Path[tw] );
  if tstr <> '' then
  begin
    i := ChangeCurDir( tstr );
    if i <> 0 then
      ErrorMessage( i )
    else
    begin
      if Loaded[3-w] and (tstr = Path[3-w]) then
        DupPathMessage
      else
      begin
        err := false;
        HelpScreen[w] := false;
        Path[w] := tstr;
        Drive[w] := GetCurDrive;
        DiskFree[w] := FreeDisk( Drive[w] );
        LoadDir( w );
      end
    end;
  end;
  ChangePath := not err;
end;

function CountMarked( w : integer ) : integer;
  {
  Counts the number of marked files that are visible
    through the current mask.
  }
var
  i, j : integer;
begin
  i := NextEntry( w, 0 );
  j := 0;
  while i <> 0 do
  begin
    if Marked[w][i] then j := j + 1;
    i := NextEntry( w, i );
  end;
  CountMarked := j;
end;

procedure CopyMarked( w : integer );
  {
  Sets up the call to CopyEntries, which does all the real work.
  }
var
  dest, tpath : str80;
  i, j        : integer;
begin
  Wind( 3 );
  clrscr;
  writeln;
  j := CountMarked( w );
  if j <> 0 then
  begin
    Disp( NATTR, ' Copy ' );
    Disp( HATTR, Cstr( j, 0, 0 ) );
    Disp( NATTR, ' marked entries to ' );
    dest := '';
    if Loaded[3-w] then
    begin
      Disp( NATTR, Path[3-w] );
      if YorN( true ) then dest := Path[3-w];
    end;
    writeln;
    if dest = '' then
    begin
      Disp( NATTR, ' Destination path > ');
      dest := GetLine( X2 - wherex - 1 );
      writeln;
    end;
    if dest <> '' then
    begin
      if Path[3-w] = dest then
      begin
        i := 0;
        j := Drive[3-w];
      end
      else
      begin
        if pos( ':', dest ) = 0 then
          i := ChangeCurDir( Path[w] );
        i := ChangeCurDir( dest );
        j := GetCurDrive;
      end;
      if i <> 0 then
         ErrorMessage( i )
      else
      begin
        if dest <> Path[w] then
        begin

          CopyEntries( w, dest, (dest = Path[3-w]) );

          if Drive[w] = j then
          begin
            DiskFree[w] := FreeDisk( j );
            WriteSizes( w, true );
          end;
          if Loaded[3-w] and (Drive[3-w] = j) then
          begin
            if Drive[3-w] = Drive[w] then DiskFree[3-w] := DiskFree[w]
            else DiskFree[3-w] := FreeDisk( j );
            if Path[3-w] = dest then LoadDir( 3-w )
            else WriteWindow( 3-w );
          end;
        end
        else
        begin
          clrscr;
          writeln;
          Disp( NATTR, ' Error: ' );
          Disp( HATTR, 'Destination path is same as source path.' );
          writeln;
          gotoxy( 9, wherey );
          wait;
        end;
      end;
    end;
  end;
end;

procedure DeleteMarked( w : integer );
  {
  Trash all the marked files that aren't masked out.
  }
var
  tstr, tstr2 : str80;
  i, err      : integer;
  done        : boolean;
begin
  i := CountMarked( w );
  if i <> 0 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Delete ' );
    Disp( HATTR, Cstr( i, 0, 0 ) );
    Disp( NATTR, ' marked entries from ' + Path[w] );
    if YorN( false ) then
    begin
      writeln;
      tstr := Path[w];
      if ord( tstr[0] ) <> 3 then tstr := tstr + '\';
      i    := NextEntry( w, 0 );
      done := false;
      while (i <> 0) and not done do
      begin
        if Marked[w][i] then
        begin
          tstr2 := ConvertName( Entry[w][i] );
          clrscr;
          writeln;
          Disp( NATTR, ' Deleting file ' );
          Disp( HATTR, tstr + tstr2 );
          err := DeleteFile( tstr + tstr2 );
          if err <> 0 then
          begin
            ErrorMessage( err );
            done := not Continue;
          end
          else
            Entry[w][i].Name[1] := DelChar;
        end;
        i := NextEntry( w, i );
      end;
      DiskFree[w] := FreeDisk( Drive[w] );
      if (Drive[3-w] = Drive[w]) and Loaded[3-w] then
      begin
        DiskFree[3-w] := DiskFree[w];
        WriteSizes( 3-w, not HelpScreen[3-w] );
      end;
      DirSize[w] := TallySizes( w );
      HomeKey( w );
    end;
  end;
end;

procedure FixWindow( w : integer );
  {
  This isn't a very good name, but the procedure removes the
    current entry from the window and then updates without
    sending the user clear to the begining of the directory.
  }
var
  i : integer;
begin
  Entry[w][CurEntry[w]].Name[1] := DelChar;
  i := LastEntry( w, TopEntry[w] );
  if i <> 0 then
  begin
    TopEntry[w] := i;
    CurEntry[w] := LastEntry( w, CurEntry[w] );
  end
  else
  begin
    if CurEntry[w] = TopEntry[w] then
    begin
      TopEntry[w] := NextEntry( w, TopEntry[w] );
      CurEntry[w] := TopEntry[w];
    end
    else
    begin
      CurLin[w] := CurLin[w] - 1;
      CurEntry[w] := LastEntry( w, CurEntry[w] );
    end;
  end;
  DiskFree[w] := FreeDisk( Drive[w] );
  if (Drive[3-w] = Drive[w]) and Loaded[3-w] then
  begin
    DiskFree[3-w] := DiskFree[w];
    WriteSizes( 3-w, not HelpScreen[3-w] );
  end;
  DirSize[w] := TallySizes( w );
  WriteWindow( w );
end;

procedure DeleteEntry( w : integer );
  {
  Sets up the deletion of a single entry.  If it is a file
    then we call DeleteFile, if it is a directory then we
    must call RemDir instead.
  }
var
  tstr, tstr2 : str80;
  err         : integer;
  dir         : boolean;
begin
  if CurEntry[w] <> 0 then
  begin
    dir := ( ( Entry[w][CurEntry[w]].Attr AND Dbit ) <> 0 );
    Wind( 3 );
    clrscr;
    writeln;
    tstr := Path[w];
    if ord( tstr[0] ) <> 3 then tstr := tstr + '\';
    tstr2 := ConvertName( Entry[w][CurEntry[w]] );
    if dir then
      Disp( NATTR, ' Remove directory ' )
    else
      Disp( NATTR, ' Delete file ' );
    Disp( NATTR, tstr + tstr2 );
    if YorN( false ) then
    begin
      writeln;
      if dir then
      begin
        err := ChangeCurDir( tstr );
        err := RemDir( tstr + tstr2 );
      end
      else
        err := DeleteFile( tstr + tstr2 );
      if err <> 0 then
        ErrorMessage( err )
      else
      begin
        FixWindow( w );
        if dir and Loaded[3-w] and (tstr+tstr2 = Path[3-w]) then
        begin
          Loaded[3-w] := false;
          HelpWindow( w, 3-w );
        end;
      end;
    end;
  end;
end;

procedure RenameEntry( w : integer );
  {
  Rename a file directly on the disk.
  }
var
  tpath, told, tnew : str80;
  i                 : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    tpath := Path[w];
    if ord( tpath[0] ) <> 3 then
      tpath := tpath + '\';
    told := ConvertName( Entry[w][CurEntry[w]] );
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Rename ' + told + ' as > ' );
    tnew := GetLine( 12 );
    writeln;
    if tnew <> '' then
    begin
      i := RenameFile( tpath + told, tpath + tnew );
      if i <> 0 then
        ErrorMessage( i )
      else
      begin
        if ParseFileName( tnew,addr( Entry[w][CurEntry[w]].Name[1] ) ) then;
        Wind( w );
        gotoxy( 1, CurLin[w] );
        WriteEntry( Marked[w][CurEntry[w]], Entry[w][CurEntry[w]] );
      end;
    end;
  end;
end;

procedure RedirectMarked( w : integer );
  {
  Move the marked entries from one directory to another on
    a disk.  Doesn't actually copy the files, just their
    directory entries.
  }
var
  tstr, fpath, topath : str80;
  i, j                : integer;
  done, reload        : boolean;
begin
  i := CountMarked( w );
  if i <> 0 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Move ' );
    Disp( HATTR, Cstr( i, 0, 0 ) );
    Disp( NATTR, ' marked entries to ' );
    topath := '';
    if Loaded[3-w] and (Drive[w] = Drive[3-w]) then
    begin
      Disp( NATTR, Path[3-w] );
      if YorN( false ) then topath := Path[3-w];
    end;
    writeln;
    if topath = '' then
    begin
      i := ChangeCurDir( Path[w] );
      Disp( NATTR, ' Destination path > ' );
      topath := GetLine( X2 - wherex - 1 );
      writeln;
      i := ChangeCurDir( topath );
      if i <> 0 then
      begin
        ErrorMessage( i );
        topath := '';
      end;
    end;
    if (Path[w] <> topath) and (topath <> '') then
    begin
      fpath := Path[w];
      reload := (topath = Path[3-w]);
      if ord( topath[0] ) <> 3 then topath := topath + '\';
      if ord( fpath[0]  ) <> 3 then fpath  := fpath  + '\';
      i    := NextEntry( w, 0 );
      done := false;
      while (i <> 0) and not done do
      begin
        if Marked[w][i] then
        begin
          clrscr;
          writeln;
          tstr := ConvertName( Entry[w][i] );
          Disp( NATTR, ' Moving file ' );
          Disp( HATTR, tstr );
          Disp( NATTR, ' to ' );
          Disp( HATTR, topath );
          j := RenameFile( fpath + tstr, topath + tstr );
          if j <> 0 then
          begin
            ErrorMessage( j );
            done := not Continue;
          end
          else
            Entry[w][i].Name[1] := DelChar;
        end;
        i := NextEntry( w, i );
      end;
      DirSize[w] := TallySizes( w );
      HomeKey( w );
      if reload then LoadDir( 3-w );
    end;
  end;
end;

procedure Sort( w : integer );
  {
  Set up call to InsertSort.
  }
const
  field  : integer = 1;
  forwrd : boolean = true;
  fwd    : array[false..true] of string[7] = ('Reverse','Forward');
var
  tstr   : str80;
  x, y   : integer;
  ch     : char;
begin
  if MaxEntry[w] > 1 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Select sort field > ' );
    x := wherex;
    y := wherey;
    repeat
      gotoxy( x, y );
      clreol;
      case field of
        0 : tstr := 'Attribute (sys,vol,dir,norm,hid,del)';
        1 : tstr := 'Name';
        2 : tstr := 'Extension';
        3 : tstr := 'Size';
        4 : tstr := 'Date and Time';
      end;
      Disp( HATTR, tstr );
      ch := KeyboardNorm;
      case upcase(ch) of
        'A' : field := 0;
        ' ',
        '+' : if field = 4 then field := 0 else field := field + 1;
        'N' : field := 1;
        'E' : field := 2;
        'S' : field := 3;
        'D',
        'T' : field := 4;
      end;
    until ch in [#27,#13];
    if (ch <> #27) and (field <> 0) then
    begin
      writeln;
      writeln;
      Disp( NATTR, ' Select sort order > ' );
      x := wherex;
      y := wherey;
      repeat
        gotoxy( x, y );
        Disp( HATTR, fwd[forwrd] );
        ch := KeyboardNorm;
        case upcase(ch) of
          ' ',
          '+' : forwrd := not forwrd;
          'F' : forwrd := true;
          'R' : forwrd := false;
        end;
      until ch in [#13, #27];
    end;
    if ch <> #27 then
    begin
      if field <> 0 then
        InsertSort( w, field, forwrd );
      InsertSort( w, 0, true );
      HomeKey( w );
      Saved[w] := false;
    end;
  end;
end;

procedure SetMask( w : integer );
  {
  Set mask to determine what files will be displayed in the window.
  }
var
  tstr : str80;
begin
  Wind( 3 );
  clrscr;
  writeln;
  Disp( NATTR, ' Enter a new mask > ' );
  tstr := GetLine( 12 );
  if tstr <> '' then
  begin
    if ParseFileName( tstr, addr( ConvMask[w][1] ) ) then
    begin
      Mask[w] := tstr;
      HomeKey( w );
    end;
  end;
end;

procedure MakeDir( w : integer );
  {
  Set up call to MakDir.
  }
var
  tstr        : str80;
  drv, err, i : integer;
  fr          : real;
begin
  Wind( 3 );
  clrscr;
  writeln;
  Disp( NATTR, ' Enter path to create > ' );
  tstr := GetLine( X2 - wherex - 1 );
  writeln;
  if tstr <> '' then
  begin
    if pos( ':', tstr ) = 0 then
      err := ChangeCurDir( Path[w] );
    err := MakDir( tstr );
    if err <> 0 then
      ErrorMessage( err )
    else
    begin
      err  := ChangeCurDir( tstr );
      tstr := '..';
      err  := ChangeCurDir( tstr );
      drv  := GetCurDrive;
      fr   := FreeDisk( drv );
      for i := 1 to 2 do
      begin
        if Loaded[i] then
        begin
          if Drive[i] = drv then DiskFree[i] := fr;
          if Path[i] = tstr then LoadDir( i )
          else WriteSizes( i, not HelpScreen[i] );
        end;
      end;
    end;
  end;
end;

procedure WriteDir( w : integer );
  {
  Determine whether or not saving the directory to disk
    is allowed and then make proper calls as per
    root or subdirectory.
  }
var
  err : integer;
begin
  Wind( 3 );
  clrscr;
  writeln;
  if NoSave[w] then
  begin
    Disp( NATTR, ' Error: ' );
    Disp( HATTR, 'Save option was disabled - directory too large.' );
    writeln;
    gotoxy( 9, wherey );
    wait;
  end
  else
  begin
    Disp( NATTR, ' Update directory ' + Path[w] + ' on disk' );
    if YorN( false ) then
    begin
      writeln;
      err := ChangeCurDir( Path[w] );
      if err <> 0 then
        ErrorMessage( err )
      else
      begin
        if ord( Path[w][0] ) = 3 then
          SaveRoot( w )
        else
          SaveSubDir( w );
        Saved[w] := true;
        if not FATsaved then SaveFAT( DiskTable[w], FATptr );
        FATsaved := true;
      end;
    end;
  end;
end;

procedure UndeleteEntry( w : integer );
  {
  Check if file can be recovered and then get a new
    first character.
  }
var
  tstr    : str80;
  amt, x  : integer;
  ch      : char;
  GotIt   : boolean;
begin
  if Entry[w][CurEntry[w]].Name[1] = DelChar then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    if NoSave[w] then
    begin
      Disp( NATTR, ' Error: ' );
      Disp( HATTR, 'Option was disabled - directory was too large.' );
      writeln;
      gotoxy( 9, wherey );
      wait;
    end
    else
    begin
      tstr := ConvertName( Entry[w][CurEntry[w]] );
      Disp( NATTR, ' Attempt to recover file ' + tstr );
      if YorN( true ) then
      begin
        writeln;
        with DiskTable[w]^ do
          amt := FATSIZE * SECTORSIZE;
        if MemoryAvail < amt then
        begin
          Disp( NATTR, ' Error: ' );
          Disp( HATTR, 'Insufficient memory for temporary FAT, aborted.' );
          writeln;
          gotoxy( 9, wherey );
          wait;
        end
        else
        begin
          GotIt := UnDel( w );
          if GotIt then
          begin
            FATsaved := false;
            Saved[w] := false;
            Disp(NATTR,' Recovery seems successful, check file to be certain.');
            writeln;
            repeat
              writeln;
              Disp( NATTR, ' Type first character > ' );
              x := wherex;
              Disp( HATTR, tstr );
              gotoxy( x, wherey );
              repeat
                ch := KeyboardNorm;
                ch := UpCase( ch );
              until CharValid( ch );
              Disp( HATTR, ch );
              writeln;
            until not CheckMatch( w, ch + copy( tstr, 2, 12 ) );
            Entry[w][CurEntry[w]].Name[1] := ch;
            Wind( w );
            gotoxy( 1, CurLin[w] );
            WriteEntry( false, Entry[w][CurEntry[w]] );
            DirSize[w] := TallySizes( w );
            WriteSizes( w, true );
          end
          else
          begin
            Disp( NATTR, ' Error: ' );
            Disp( HATTR, 'File has been overwritten, recovery not possible.' );
            writeln;
            gotoxy( 9, wherey );
            wait;
          end
        end;
      end;
    end;
  end;
end;

procedure Purge( w : integer );
  {
  Clear out all the deleted files that show up on menu
    two all the time.
  }
var
  i, j : integer;
begin
  j := 0;
  for i := 1 to MaxEntry[w] do
    if Entry[w][i].Name[1] = DelChar then j := j + 1;
  if j <> 0 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Purge ' );
    Disp( HATTR, Cstr( j, 0, 0 ) );
    Disp( NATTR, ' deleted file entries from ' + Path[w] );
    if YorN( true ) then
    begin
      Saved[w] := false;
      RemoveDeleted( w );
      HomeKey( w );
    end;
  end;
end;

procedure ToggleAttr( w : integer );
  {
  Check wich attribute should be toggled and then make
    the appropriate call to ChangeAttr.
  }
const
  atnum : integer = 1;
var
  tstr     : str80;
  x, y, i  : integer;
  newattr  : byte;
  ch       : char;
begin
  if CurEntry[w] <> 0 then
  begin
    Wind( 3 );
    clrscr;
    writeln;
    Disp( NATTR, ' Select attribute to toggle > ' );
    x := wherex;
    y := wherey;
    begin
      repeat
        gotoxy( x, y );
        clreol;
        case atnum of
          0 : Disp( HATTR, 'Archive' );
          1 : Disp( HATTR, 'Hidden' );
          2 : Disp( HATTR, 'Read-only' );
        end;
        ch := KeyboardNorm;
        case upcase(ch) of
          ' ',
          '+' : if atnum = 2 then atnum := 0 else atnum := atnum + 1;
          'A' : atnum := 0;
          'H' : atnum := 1;
          'R' : atnum := 2;
        end;
      until ch in [#13,#27];
      if ch <> #27 then
      begin
        writeln;
        case atnum of
          0 : newattr := Entry[w][CurEntry[w]].Attr XOR Abit;
          1 : newattr := Entry[w][CurEntry[w]].Attr XOR Hbit;
          2 : newattr := Entry[w][CurEntry[w]].Attr XOR Rbit;
        end;
        tstr := Path[w];
        if ord( tstr[0] ) <> 3 then tstr := tstr + '\';
        tstr := tstr + ConvertName( Entry[w][CurEntry[w]] );
        i := ChangeAttr( tstr, newattr );
        if i <> 0 then
          ErrorMessage( i )
        else
        begin
          Entry[w][CurEntry[w]].Attr := newattr;
          Wind( w );
          gotoxy( 1, CurLin[w] );
          WriteEntry( Marked[w][CurEntry[w]], Entry[w][CurEntry[w]] );
        end;
      end;
    end;
  end;
end;

procedure ClearDisk( var w : integer );
  {
  Allows clearing of the floppy drives only.  We want to
    be real careful about allowing people to wipe something out.
  }
const
  d : integer = 1;
var
  drv       : integer;
  disktable : DskTblptr;
begin
  Wind( 3 );
  clrscr;
  writeln;
  Disp( NATTR, ' Warning: ' );
  Disp( HATTR, 'Data on disk will be overwritten (ESC to abort function).' );
  writeln;
  writeln;
  Disp( NATTR, ' Select floppy drive to CLEAR > ' );
  drv := SelectFloppy( d );
  if drv <> 0 then
  begin
    d := drv;
    writeln;
    Disp( NATTR, ' Insert disk and ' );
    wait;
    writeln;
    GetTable( drv, disktable );
    ClearFAT( drv, disktable );
    if Loaded[w] and (Drive[w] = drv) then
    begin
      Path[w] := copy( Path[w], 1, 3 );
      ReloadDir( w, 1 );
    end;
    if Loaded[3-w] and (Drive[3-w] = drv) then
    begin
      if Drive[3-w] = Drive[w] then
      begin
        Loaded[3-w] := false;
        HelpWindow( w, 3-w );
      end
      else
      begin
        Path[3-w] := copy( Path[3-w], 1, 3 );
        ReloadDir( 3-w, 1 );
      end;
    end;
  end;
end;

procedure ChangeName( w : integer );
  {
  Allow user to rename most entries to anything they can type
    at the keyboard.
    Exceptions:  '.' and '..' are reserved entries
          Also:  names containing a period are formatted as DOS would
  }
var
  tstr : str80;
  i, j : integer;
begin
  if CurEntry[w] <> 0 then
  begin
    tstr := ConvertName( Entry[w][CurEntry[w]] );
    if (tstr <> '.') and (tstr <> '..') then
    begin
      Wind( 3 );
      clrscr;
      writeln;
      Disp( NATTR, ' Rename ' + tstr );
      writeln;
      Disp( NATTR, '   as > ' );
      tstr := GetLine( 12 );
      j    := pos( '.', tstr );
      if (tstr <> '') and (j <> 1) then
      begin

        for i := 1 to ord( tstr[0] ) do
          tstr[i] := UpCase( tstr[i] );
        if j = 0 then
          tstr := copy( tstr, 1, 8 )
        else
        begin
          for i := j to 8 do
            insert( ' ', tstr, i );
          delete( tstr, 9, pos( '.', tstr ) - 8 );
        end;

        if Entry[w][CurEntry[w]].Name[1] = DelChar then tstr[1] := DelChar;
        tstr := tstr + '            ';
        move( tstr[1], Entry[w][CurEntry[w]].Name[1], 11 );
        Wind( w );
        gotoxy( 1, CurLin[w] );
        WriteEntry( false, Entry[w][CurEntry[w]] );
        Saved[w] := false;
      end;
    end;
  end;
end;

procedure VolLabel( w : integer );
  {
  Allow the deletion, creation or renaming of the volume
    label if the current directory is the root.
  }
var
  tstr : str80;
  i    : integer;
  done : boolean;
begin
  done := false;
  Wind( 3 );
  clrscr;
  writeln;
  if ord( Path[w][0] ) <> 3 then
  begin
    Disp( NATTR, ' Error: ' );
    Disp( HATTR, 'Volume label only valid in root directory' );
    writeln;
    gotoxy( 9, wherey );
    wait;
  end
  else
  begin
    i := 1;
    while ( ((Entry[w][i].Attr AND Vbit) = 0)
            or (Entry[w][i].Name[1] = DelChar) ) and (i <= MaxEntry[w]) do
      i := i + 1;
    if i > MaxEntry[w] then i := 0;
    if i <> 0 then
    begin
      Disp( NATTR, ' Delete old label, ' + ConvertName( Entry[w][i] ) );
      done := YorN( false );
      if done then
      begin
        Entry[w][i].Name[1] := DelChar;
        i := 0;
        Saved[w] := false;
      end;
    end;
    if not done then
    begin
      clrscr;
      writeln;
      if i <> 0 then
        Disp( NATTR, ' Current label is  ' + ConvertName( Entry[w][i] ) )
      else
        Disp( NATTR, ' There is no current label.' );
      writeln;
      Disp( NATTR,   ' Enter new label > ' );
      tstr := GetLine( 11 );
      if tstr <> '' then
      begin
        if i = 0 then
        begin
          repeat
            i := i + 1;
          until (Entry[w][i].Name[1] = DelChar) or (i > MaxEntry[w]);
          if (i > MaxEntry[w]) then
          begin
            if (i <= MaxFiles) then
              MaxEntry[w] := i
            else
              i := 0;
          end;
        end;
        if i <> 0 then
        begin
          with Entry[w][i] do
          begin
            tstr    := tstr + '           ';
            Attr    := Vbit;
            Time    := SysTime;
            Date    := SysDate;
            Cluster := 0;
            Size[0] := 0;
            Size[1] := 0;
            move( tstr[1], Name[1], 11 );
          end;
          Saved[w] := false;
        end;
      end;
    end;
    HomeKey( w );
  end;
end;